home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / rerecycl.arc / RECYCLE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-29  |  2KB  |  112 lines

  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Recycle - determine if PCBoard should be recycled (3-1-89)
  15.  *
  16.  *)
  17.  
  18. {$v-}
  19. {$l+,d+}
  20.  
  21. uses dos;
  22.  
  23. const
  24.    version  = 'ProDoor Recycle Utility  Version 1.5, 07-29-89 S.H.Smith';
  25.  
  26. type
  27.    pcbsys_rec = array[0..127] of char;
  28.    
  29. var
  30.    port: string;
  31.    code: integer;
  32.    fd:   text;
  33.    line: string;
  34.    sys:  file of pcbsys_rec;
  35.    rec:  pcbsys_rec;
  36.  
  37.  
  38. (*
  39.  * main program
  40.  *
  41.  *)
  42.  
  43. begin
  44.    assign(output,'');
  45.    rewrite(output);
  46.  
  47.    writeln;
  48.    writeln(version);
  49.  
  50. (* load pcboard.sys file to see if user is logged in *)
  51.    assign(sys,'pcboard.sys');
  52.    {$i-} reset(sys); {$i+}
  53.    if ioresult = 0 then
  54.    begin
  55.       read(sys,rec);
  56.       close(sys);
  57.    end
  58.    else
  59.    begin
  60.       writeln('!CAN''T OPEN PCBOARD.SYS!');
  61.       rec[14] := ' ';
  62.    end;
  63.       
  64. (* do not recycle prodoor empty pcboard.sys was found *)
  65.  
  66. (* changed code to 2 if pcboard.sys is empty by Don Cheeks & Lana Fox *)
  67. (* on 07-22-89                                                        *)
  68.  
  69.    if (rec[14] <= ' ') or (rec[11] <= ' ') then
  70.    begin
  71.       code := 2;  {load pcboard}
  72.       write('<logoff>');
  73.    end
  74.    else
  75.    
  76. (* possible return from other doors; examine $door.bat *)
  77.  
  78.    begin
  79.       assign(fd,'$door.bat');
  80.       {$i-} reset(fd); {$i+}
  81.       if ioresult <> 0 then
  82.       begin
  83.          code := 1;  {load pcboard}
  84.          write('<no $door.bat>');
  85.       end
  86.       else
  87.  
  88.       begin
  89.          {$i-}
  90.          readln(fd,line);  {c:}
  91.          readln(fd,line);  {cd ...}
  92.          readln(fd,line);  {copy...}
  93.          close(fd);
  94.          {$i+}
  95.  
  96.          if (ioresult = 0) and (copy(line,1,4) = 'copy') then
  97.          begin
  98.             code := 0;  {return to prodoor}
  99.             write('<return from subdoor>');
  100.          end 
  101.          else     
  102.          begin
  103.             code := 1;  {return to pcboard}
  104.             write('<close prodoor>');
  105.          end
  106.       end;
  107.    end;
  108.  
  109.    writeln(' - errorlevel set to ',code);
  110.    halt(code);
  111. end.
  112.